home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / intuition / NewMenu.st < prev    next >
Encoding:
Text File  |  2004-01-31  |  7.4 KB  |  282 lines
  1. " ---------------------------------------------------------------------
  2. * MenuStrip class is an Array of NewMenu Objects.  It also contains the
  3. * methods to set & clear itself from a parent Window.
  4. * --------------------------------------------------------------------- 
  5. "
  6. Class MenuStrip :Object ! mStrip parentWindow menuSize !
  7. [
  8.    attachedTo
  9.  
  10.      ^ parentWindow
  11. |
  12.    attachTo: aWindow ! check !
  13.  
  14.      parentWindow <- aWindow windowObject.
  15.  
  16.      " This all-in-one primitive does CreateMenus(), LayoutMenus() &
  17.      * SetMenuStrip():
  18.      "
  19.      check <- <primitive 181 21 mStrip parentWindow>.
  20.      
  21.      (check ~= true)
  22.         ifTrue: [ 'Menu Strip NOT Attached!!' print.
  23.                    parentWindow <- nil ]
  24. |
  25.    hide
  26.  
  27.      <primitive 181 22 parentWindow>
  28. |
  29.    append: newMenuObject
  30.  
  31.      (1 to: menuSize) 
  32.         do: [ :i | ((mStrip at: i) isNil)
  33.                      ifTrue: [mStrip at: i put: newMenuObject. 
  34.                                                  
  35.                               ^ self ] ].
  36.      ^ self
  37. |
  38.    new: numberOfElements  " Must include space for NM_END as well. "
  39.  
  40.      menuSize <- numberOfElements.
  41.      
  42.      mStrip   <- Array new: numberOfElements.
  43.      
  44.      ^ self
  45. ]
  46.  
  47. " ---------------------------------------------------------------------
  48. * NewMenu Class is the class that creates NewMenu items that are
  49. * used by the gadtools.library
  50. *
  51. * structureArray is an Array Object with the following
  52. * elements in the given order:
  53. * ele[1] <- nm_Type,          ele[2] <- nm_Label,
  54. * ele[3] <- nm_CommKey,       ele[4] <- nm_Flags,
  55. * ele[5] <- nm_MutualExclude, ele[6] <- nm_UserData 
  56. *
  57. * ele[6] is an Array as follows:
  58. *
  59. *    udele[1] <- Menu Type (#NM_TITLE, #NM_ITEM, #NM_SUB, #IM_ITEM,
  60. *                           or #IM_SUB)
  61. *    udele[2] <- menu ID_String,
  62. *    udele[3] <- userData (Usually a #methodSymbol,
  63. *    udele[4] <- equivalent to ele[3] (nm_CommKey)
  64. *
  65. *   Making a menu:
  66. *
  67. *   menuStrip  <- MenuStrip new: 3
  68. *   menu1      <- NewMenu new
  69. *   menu1Array <- menu1 titleMenuArray: 'PROJECT'
  70. *   menu2      <- NewMenu new
  71. *
  72. *   menuAction <- Array new: 3
  73. *   menuAction at: 1 put: #loadFileActionMethod
  74. *   menuAction at: 2 put: 'Load a file...'
  75. *   menuAction at: 3 put: 'L'
  76. *
  77. *   menu2Array <- menu2 menuItemArray: 'Load a file...' key: 'L' 
  78. *                               flags: 0 data: menuAction
  79. *
  80. *   menu3      <- NewMenu new
  81. *
  82. *   You MUST have one of these for a valid menu strip:
  83. *   menu3 fillNewMenuItemWith: (menu3 endOfMenuArray)
  84. *
  85. *   menuStrip at: 1 put: menu1
  86. *   menuStrip at: 2 put: menu2
  87. *   menuStrip at: 3 put: menu3
  88. *
  89. *   menuStrip attachTo: myWindow
  90. * --------------------------------------------------------------------- 
  91. " 
  92. Class NewMenu :Object
  93. ! private intuition windowObj structArray myAction !
  94. [
  95.    xxxDisposeMenu
  96.  
  97.       <primitive 239 1 0 (self xxxMenu)>.
  98.       
  99.       <primitive 250 5 0 private>.
  100. |
  101.    dispose               " Synonym for xxxDisposeMenu "
  102.  
  103.       self xxxDisposeMenu.
  104.       
  105.       ^ nil
  106. |
  107.    new: newAction
  108.  
  109.       intuition   <- Intuition new.   
  110.       structArray <- Array     new: 6.
  111.       private     <- <primitive 239 1 1 1>.
  112.  
  113.       self value: newAction.
  114.       
  115.       ^ self
  116. |
  117.    addedTo: menuStrip
  118.  
  119.       ^ menuStrip append: (self xxxMenu).
  120. |
  121.    registerTo: myWindowObject
  122.    
  123.       (myWindowObject isNil)
  124.          ifTrue: [ 'NewMenu Object given a nil Window object!' print.
  125.                    ^ nil
  126.                  ].
  127.  
  128.       ^ windowObj <- myWindowObject
  129. |
  130.    xxxMenu
  131.  
  132.       " In order to avoid changing the underlying primitive code
  133.       * (again!), this method will return the NewMenu Object
  134.       * from the private Object:
  135.       "
  136.       ^ (private at: 1)
  137. |
  138.    value: newAction       " testMenu is an example Action "
  139.       
  140.       ^ myAction <- newAction
  141. |
  142.    value
  143.       
  144.       ^ myAction
  145. |
  146.    initializeControl  " Only NewGadgets need this method to do something: "
  147.    
  148.       ^ nil
  149. |
  150.    testMenu ! ans !  
  151.    
  152.       " this is a test method for UserGUI to use & is setup
  153.       * by setting >> userData at: 3 put: #testMenu << 
  154.       "
  155.       amigatalk setIOTitle: 'Menu Test Action:'.
  156.       
  157.       ans <- amigatalk getUserResponse: ('You selected: "', 
  158.                                          ((structArray at: 2) asString), 
  159.                                          '" Do you want to continue?').
  160.       
  161.       (ans = 0)
  162.          ifTrue:  [ ^ true  ]
  163.          ifFalse: [ ^ false ] " Terminate UserGUI/controlLoop "
  164. |
  165.    menuUserData: userDataArray
  166.    
  167.       structArray at: 6 put: userDataArray
  168. |
  169.    fillNewMenuItemWith: structureArray
  170.    
  171.       (1 to: 6) do: [ :i | structArray at: i 
  172.                                       put: (structureArray at: i) ].
  173.       
  174.       (<primitive 239 1 2 1 structArray private> ~= true)
  175.          ifTrue: [ self xxxDisposeMenu.
  176.                    'ERROR:  Could NOT fill a NewMenu entry!' print.
  177.                    ^ nil
  178.                  ] 
  179. |
  180.    endOfMenuArray ! endArray !  " Required by ALL menuStrips "
  181.  
  182.       endArray <- self xxxMakeArray: nil k: nil f: 0 data: 0.
  183.       
  184.       endArray at: 1 put: (intuition systemTag: #NM_END).
  185.  
  186.       ^ endArray
  187. |
  188.    titleMenuArray: title ! rval ! " Make a new Menu TITLE: "
  189.  
  190.       rval <- self xxxMakeArray: title k: nil f: 0 data: nil.
  191.  
  192.       rval at: 1 put: (intuition systemTag: #NM_TITLE).
  193.  
  194.       self fillNewMenuItemWith: rval.
  195.       
  196.       ^ rval
  197. |
  198.    barLabel ! rval ! " Make a new Menu item NM_BARLABEL: "
  199.  
  200.       rval <- self xxxMakeArray: nil k: nil f: 0 data: nil.
  201.  
  202.       rval at: 1 put: (intuition systemTag: #NM_BARLABEL).
  203.       
  204.       self fillNewMenuItemWith: rval.
  205.  
  206.       ^ rval
  207. |
  208.    menuItemArray: title key: commKey flags: flags data: userData ! rval !    
  209.    
  210.       " Make a new Menu ITEM: "
  211.  
  212.       rval <- self xxxMakeArray: title    k: commKey 
  213.                               f: flags data: userData.
  214.  
  215.       rval at: 1 put: (intuition systemTag: #NM_ITEM).
  216.  
  217.       self fillNewMenuItemWith: rval.
  218.             
  219.       ^ rval
  220. |
  221.    subItemArray: title key: commKey flags: flags data: userData ! rval !
  222.  
  223.       " Make a new menu SUB: "
  224.  
  225.       rval <- self xxxMakeArray: title    k: commKey 
  226.                               f: flags data: userData.
  227.  
  228.       rval at: 1 put: (intuition systemTag: #NM_SUB).
  229.       
  230.       self fillNewMenuItemWith: rval.
  231.  
  232.       ^ rval
  233. |
  234.    menuItemSpace ! rval !    
  235.    
  236.       " Make a new Menu ITEM that is blank #NM_IGNORE: "
  237.  
  238.       rval <- self xxxMakeArray: nil k: nil f: 0 data: nil.
  239.  
  240.       rval at: 1 put: (intuition systemTag: #NM_IGNORE).
  241.       
  242.       self fillNewMenuItemWith: rval.
  243.  
  244.       ^ rval
  245. |
  246.    menuImageArray: image key: commKey flags: flags data: userData ! rval !
  247.  
  248.       " Make a new Menu IM_ITEM: "
  249.  
  250.       rval <- self xxxMakeArray: image    k: commKey 
  251.                               f: flags data: userData.
  252.  
  253.       rval at: 1 put: (intuition systemTag: #IM_ITEM).
  254.       
  255.       self fillNewMenuItemWith: rval.
  256.  
  257.       ^ rval
  258. |
  259.    subImageArray: image key: commKey flags: flags data: userData ! rval !
  260.  
  261.       " Make a new Menu IM_SUB: "
  262.  
  263.       rval <- self xxxMakeArray: image    k: commKey 
  264.                               f: flags data: userData.
  265.  
  266.       rval at: 1 put: (intuition systemTag: #IM_SUB).
  267.  
  268.       self fillNewMenuItemWith: rval.
  269.       
  270.       ^ rval
  271. |
  272.    xxxMakeArray: t k: k f: f data: data
  273.  
  274.       structArray at: 2 put: t.     " menu title string   "
  275.       structArray at: 3 put: k.     " menu shortcut key   "
  276.       structArray at: 4 put: f.     " menu flags          "
  277.       structArray at: 5 put: 0.     " mutualexclude value "
  278.       structArray at: 6 put: data.  " menu userdata       "
  279.       
  280.       ^ structArray
  281. ]
  282.